'{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{
'   WPX  C O N T E S T - D U P E  &  S A V E    P R O G R A M
'          by Bj. Madsen - VE5FX      Nov. 11, 1986
'}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}

' This program is designed for the CQ-WW-WPX Contest.  It will allow input
' of callsigns for contest duping purposes, duping for match per band.
' It also checks PREFIXES for dupe, and informs you if a new prefix
' has been worked.  A total is displayed of QSOs per band as well as
' total number of prefixes for combined bands for the contest.  It also tests
' for valid callsigns, requiring both numbers and letters and allowing
' for the inclusion of a slash.   A NEW callsign will provide
' a choice of whether to save or pass.  Callsigns will be saved to a
' pre-defined disk file every 20 entries or whenever the command <SAVE>
' is entered in place of a callsign.  At the end of a band-session, enter
' the word <END>.  Outstanding calls will be saved and the program will end.
' New prefixes worked will be added to the PREFIXES file, and loaded again
' when the new band-file is loaded or established. 

 
 CLEAR ,100000
 DEFINT K-Z
  DIM M$(21) : DIM Z$(21) : DIM TPX$(21) :DIM PX$(2000)
  DIM A$(400):DIM b$(400): DIM C$(500): DIM D$(500): DIM E$(400)
  DIM F$(400): DIM G$(400): DIM H$(400): DIM I$(400): DIM J$(400) 
   CLS:WINDOW 1, "WPX CONTEST DUPING PROGRAM ",(0,0)-(610,185),15
   
  TITLE: '----------------------------------------------------Title for menu
    LINE (0,0)-(640,5),3,bf
    LINE (0,0)-(10,200),3,bf
    LINE (607,0)-(617,200),3,bf
    LINE (0,181)-(617,186),3,bf
    LINE (0,30)-(640,35),3,b
    PAINT (20,10),2,3
    PAINT (20,33),1,3
    COLOR 3,2
    LOCATE 3,25:PRINT " W P X   CONTEST DUPER "
    COLOR 2,3 :PRINT :PRINT 
    PRINT :PRINT :PRINT TAB(10)"  To save fewer than 20 calls to disk, enter the word <SAVE>  "
    PRINT TAB(22)"  rather than the regular callsign..... "
    PRINT:PRINT TAB(15)"====>  shift NOW to UPPER CASE LETTERS  <===="
   
    COLOR 1,0
    PRINT :PRINT :PRINT TAB(15)"Are there calls to be entered from a disk file";:INPUT A$
       IF LEFT$(A$,1) = "Y" OR LEFT$(A$,1) = "y" THEN GOTO LOAD.CALLS
'-------------------------------------------------------Create a file on disk
    PRINT :PRINT :PRINT  TAB(15)"What filename do you wish to use";:INPUT DUPEFILE$
     PRINT :COLOR 2,3:PRINT TAB(15)" Creating output file named: ";DUPEFILE$ :COLOR 1,0
      OPEN DUPEFILE$ FOR OUTPUT AS #1 
      CLOSE #1 : QP$=""
      PRINT :PRINT TAB(15)"Do you wish to CREATE a new PREFIX FILE";:INPUT QP$  
        IF QP$ = "YES" THEN
           COLOR 2,3
           PRINT :PRINT TAB(15) " Creating PREFIXES file: "
           COLOR 1,0
           OPEN "PREFIXES" FOR OUTPUT AS #1
           CLOSE #1
        ELSE
           GOTO LOAD.PFX
        END IF
'--------------------------------------------------------Set up input windows
SET.WINDOW:
   CLS
    WINDOW 1,"CONTACTS MADE:",(160,30)-(440,185),2
    WINDOW 3,"PREFIX DATA:",(100,16)-(510,26),2
    WINDOW 2,"WPX Contest at VE5FX: ",(1,1)-(610,10),2

DATA.ENTRY:   '---------------------------------------Get callsign for entry
      WINDOW OUTPUT 3 : COLOR 2,1 : CLS
      PRINT TAB(10)" Total Prefixes worked: ";PX;
      WINDOW OUTPUT 2 : COLOR 1,2: CLS
      INPUT"  What is the callsign.....";CS$
      IF CS$ = "SAVE" OR CS$ = "END" THEN GOSUB SAVE.PFX: GOSUB  SAVE.TO.DISK: GOTO DATA.ENTRY
      
'-------------------------------------------------Check callsign for validity
    N=0 : P=0 : L=0
    FOR V = 2 TO LEN(CS$)
      X$ = MID$(CS$,V,1)
        IF X$<"/" OR X$>"9" AND X$<"A" OR X$>"Z" THEN N=N+1
         IF (X$>"/") AND (X$<":") AND (P = 0) THEN P=V      'finds first number
        IF X$>"@" AND X$<"[" THEN L=V
     NEXT V   
        IF (N>0) OR (P=0) OR (L=0) THEN GOTO FLASH
     ON VAL(MID$(CS$,P,1)) GOTO ONE,TWO,THREE,FOUR,FIVE,SIX,SEVEN,EIGHT,NINE  
     IF VAL(MID$(CS$,P,1))=0 THEN ZERO
     
FLASH:     '-------------------Data entry error message for invalid callsigns
  WINDOW OUTPUT 2: COLOR 1,2
    FOR V = 1 TO 10
     BEEP
     PRINT TAB(10)">>>>> I N V A L I D    C A L L S I G N <<<<<"
    NEXT V
  GOTO DATA.ENTRY 
 
'-------------------------------------------------------- Save callsigns, etc. 
ONE:
  FOR X=1 TO A
    IF A$(X) = CS$ THEN K$=A$(X): GOTO DUPE.TELL
  NEXT X  
    GOSUB PREFIX:GOSUB SAVE.CALL
    IF C$="S" THEN A=A+1: A$(A)=CS$:WINDOW OUTPUT 1: COLOR 1,0: PRINT A+b+C+D+E+F+G+H+I+J,A$(A),A
  GOTO DATA.ENTRY
  
TWO:
    FOR X=1 TO b
    IF b$(X) = CS$ THEN K$=b$(X): GOTO DUPE.TELL
  NEXT X  
    GOSUB PREFIX:GOSUB SAVE.CALL
    IF C$="S" THEN b=b+1: b$(b)=CS$:WINDOW OUTPUT 1: COLOR 1,0: PRINT A+b+C+D+E+F+G+H+I+J,b$(b),b
  GOTO DATA.ENTRY
   
THREE:
  FOR X=1 TO C
    IF C$(X) = CS$ THEN K$=C$(X): GOTO DUPE.TELL
  NEXT X  
    GOSUB PREFIX:GOSUB SAVE.CALL
    IF C$="S" THEN C=C+1: C$(C)=CS$:WINDOW OUTPUT 1: COLOR 1,0: PRINT A+b+C+D+E+F+G+H+I+J,C$(C),C
  GOTO DATA.ENTRY

FOUR:
  FOR X=1 TO D
    IF D$(X) = CS$ THEN K$=D$(X): GOTO DUPE.TELL
  NEXT X  
    GOSUB PREFIX:GOSUB SAVE.CALL
    IF C$="S" THEN D=D+1: D$(D)=CS$:WINDOW OUTPUT 1: COLOR 1,0: PRINT A+b+C+D+E+F+G+H+I+J,D$(D),D
  GOTO DATA.ENTRY

FIVE:
  FOR X=1 TO E
    IF E$(X) = CS$ THEN K$=E$(X): GOTO DUPE.TELL
  NEXT X  
    GOSUB PREFIX:GOSUB SAVE.CALL
    IF C$="S" THEN E=E+1: E$(E)=CS$:WINDOW OUTPUT 1: COLOR 1,0: PRINT A+b+C+D+E+F+G+H+I+J,E$(E),E
  GOTO DATA.ENTRY

SIX:
  FOR X=1 TO F
    IF F$(X) = CS$ THEN K$=F$(X): GOTO DUPE.TELL
  NEXT X  
    GOSUB PREFIX:GOSUB SAVE.CALL
    IF C$="S" THEN F=F+1: F$(F)=CS$:WINDOW OUTPUT 1: COLOR 1,0: PRINT A+b+C+D+E+F+G+H+I+J,F$(F),F
  GOTO DATA.ENTRY

SEVEN:
  FOR X=1 TO G
    IF G$(X) = CS$ THEN K$=G$(X): GOTO DUPE.TELL
  NEXT X  
    GOSUB PREFIX:GOSUB SAVE.CALL
    IF C$="S" THEN G=G+1: G$(G)=CS$:WINDOW OUTPUT 1: COLOR 1,0: PRINT A+b+C+D+E+F+G+H+I+J,G$(G),G
  GOTO DATA.ENTRY
 
EIGHT: 
  FOR X=1 TO H
    IF H$(X) = CS$ THEN K$=H$(X): GOTO DUPE.TELL
  NEXT X  
    GOSUB PREFIX:GOSUB SAVE.CALL
    IF C$="S" THEN H=H+1: H$(H)=CS$:WINDOW OUTPUT 1: COLOR 1,0: PRINT A+b+C+D+E+F+G+H+I+J,H$(H),H
  GOTO DATA.ENTRY

NINE:
  FOR X=1 TO I
    IF I$(X) = CS$ THEN K$=I$(X): GOTO DUPE.TELL
  NEXT X  
    GOSUB PREFIX:GOSUB SAVE.CALL
    IF C$="S" THEN I=I+1: I$(I)=CS$:WINDOW OUTPUT 1: COLOR 1,0: PRINT A+b+C+D+E+F+G+H+I+J,I$(I),I
  GOTO DATA.ENTRY
 
ZERO:
  FOR X=1 TO J
    IF J$(X) = CS$ THEN K$=J$(X): GOTO DUPE.TELL
  NEXT X  
    GOSUB PREFIX:GOSUB SAVE.CALL
    IF C$="S" THEN J=J+1: J$(J)=CS$:WINDOW OUTPUT 1: COLOR 1,0: PRINT A+b+C+D+E+F+G+H+I+J,J$(J),J
  GOTO DATA.ENTRY
   
DUPE.TELL:     '------------------------------------------------ dupe message
   WINDOW OUTPUT 2: COLOR 2,1
   FOR V=1 TO 10: BEEP
     PRINT TAB(10) "  DUPE ==> ";K$;" is already on file.....  ";
   NEXT V: GOTO DATA.ENTRY 

SAVE.CALL:          '------------------------------Make choice - save or pass
   WINDOW OUTPUT 2: COLOR 2,1
      PRINT TAB(15)"  " CS$;" is a new call...<S>ave or <P>ass?  ";
    LOOP:
     C$=INKEY$
       IF C$ = "S" THEN 
         M=M+1
         M$(M)=CS$
           IF DUPE = 0 THEN
             PX=PX+1
             PX$(PX)=LEFT$(CS$,P)
             NPX=NPX+1
             TPX$(NPX)=PX$(PX)
           END IF
       END IF
       IF M = 20 THEN GOSUB SAVE.TO.DISK: RETURN
       IF C$ = "S" THEN RETURN
       IF C$ = "P" THEN RETURN
     GOTO LOOP
PREFIX:     '------------------------------------------------Dupe for prefix
   DUPE = 0 
   FOR Y = 1 TO PX
     IF PX$(Y) = LEFT$(CS$,P) THEN DUPE = 1 
   NEXT Y 
   IF DUPE = 1 THEN 
      WINDOW OUTPUT 3
      CLS:COLOR 3,1
      PRINT TAB(12)"  ";LEFT$(CS$,P);" is already on file";
   END IF
   IF DUPE = 0 THEN
      WINDOW OUTPUT 3
      CLS:COLOR 3,1
      PRINT TAB(10)"[[[[[ ";
      COLOR 1,2:PRINT " "LEFT$(CS$,P)" ";
      COLOR 3,1:PRINT " ]]]]] is a NEW PREFIX !!";
   END IF
   IF NPX = 20 THEN GOSUB SAVE.PFX
  RETURN 
  
SAVE.PFX:       '------------------------------------save 20 prefixes to disk
   WINDOW OUTPUT 1: COLOR 3,0
   PRINT "Saving ";NPX;" prefixes to disk"
   OPEN "A",#1,"PREFIXES"
      FOR V=1 TO NPX
         PRINT #1,TPX$(V)
      NEXT V
    CLOSE #1:NPX=0 :COLOR 1,0
   RETURN
     
SAVE.TO.DISK:     '-----------------------save 20 calls or fewer to disk file
  WINDOW OUTPUT 1: COLOR 3,0
  PRINT "Saving ";M;" calls to file: ";DUPEFILE$
    OPEN "A",#1, DUPEFILE$
      FOR V=1 TO M
         PRINT #1, M$(V)
      NEXT V
    CLOSE #1: M=0 : COLOR 1,0
   IF CS$ = "END" THEN END :ELSE RETURN
    
LOAD.CALLS: '--------------------------load previously created file from disk
  PRINT :PRINT :PRINT TAB(15)"What filename do you wish to load";:INPUT DUPEFILE$
  OPEN "I",#1,DUPEFILE$
   WHILE NOT EOF(1)
    INPUT #1, CS$
      FOR V=1 TO LEN(CS$)
        X$=MID$(CS$,V,1)
        IF X$>"/" AND X$<":" THEN N=VAL(X$)    'N is value of last number
      NEXT V
    
      ON N GOTO WON,TOO,THR,FER,FIV,SEX,SEV,ATE,NIN
      IF N = 0 THEN DIX
    WON:  A=A+1: A$(A)=CS$: GOTO LAST
    TOO:  b=b+1: b$(b)=CS$: GOTO LAST
    THR:  C=C+1: C$(C)=CS$: GOTO LAST
    FER:  D=D+1: D$(D)=CS$: GOTO LAST 
    FIV:  E=E+1: E$(E)=CS$: GOTO LAST
    SEX:  F=F+1: F$(F)=CS$: GOTO LAST
    SEV:  G=G+1: G$(G)=CS$: GOTO LAST
    ATE:  H=H+1: H$(H)=CS$: GOTO LAST
    NIN:  I=I+1: I$(I)=CS$: GOTO LAST
    DIX:  J=J+1: J$(J)=CS$: GOTO LAST
    LAST:
  WEND
   CLOSE #1: COLOR 0,3
LOAD.PFX:   '------------------------------------------- Read in prefix file 
OPEN "I",#1,"PREFIXES"
  WHILE NOT EOF(1)
    PX = PX + 1
     INPUT #1,PX$(PX)
  WEND
  CLOSE #1
   PRINT 
   PRINT TAB(10) " A total of ";A+b+C+D+E+F+G+H+I+J;" callsigns in ";DUPEFILE$
   PRINT :PRINT TAB(10) " and a total of ";PX;" Prefixes worked so far... "
   COLOR 3,0:PRINT :PRINT 
   PRINT TAB(20)"Press <RETURN> to continue.....";:INPUT C$
  GOTO SET.WINDOW